home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / subntx2.zip / SUBROWSE.PRG < prev    next >
Text File  |  1990-05-24  |  4KB  |  244 lines
  1. PARAMETERS dbfname, indexname, lkey, hkey, pattern, filt_cond, tries
  2. external descend
  3.  
  4. * I thought I'd through in this kind of utility I have used to do some 
  5. * testing.  Please forgive my on-the-fly program writing style. Use this
  6. * from the C: prompt as a utility to browse a subset of a database, using
  7. * its associated (and updated) index to extract the sub index from.
  8. * 
  9. * SYNTAX:  subrowse <dbfname> <indexname> <lkey> <hkey> <pattern>
  10. * 
  11. * Notice optional "" in example.
  12. * 
  13. * EXAMPLE: 
  14. *
  15. *   subrowse test testindex A            && everything beginning with 'A'
  16. * 
  17. *   subrowse test testindex "A"          && same as above
  18. * 
  19. *   subrowse test testindex "A "         && everything beginning with 'A '
  20. * 
  21. *   subrowse test testindex A B "*THE*"  && Everything between A and B
  22. *                                           with the work "THE" somewhere
  23. *                                           in the key.
  24. *
  25. *   subrowse test testindex A B "*THE*" "lname=='Moon'"    && Same as above
  26. *                                        && but also calls _subeval() with
  27. *                                        && the condition.  Be careful its
  28. *                                        && a valid condition.
  29. *
  30. * 
  31. * 
  32. * 
  33. *   Thanks for your support.....
  34. * 
  35.  
  36. PUBLIC use_extproc
  37. public times[2]
  38.  
  39.  
  40.  
  41.  
  42. DO CLSCREEN
  43.  
  44. if pcount() < 3
  45.     ? "Usage: subrowse <dbfname>, <ntxname>, <lkey> [,<hkey> [,<pattern> [,<filt_cond>]]]"
  46.     quit
  47. endif             
  48.  
  49.  
  50. if type("hkey") == "U"
  51.     hkey = ""
  52. endif
  53.  
  54. if type("pattern") == "U"
  55.     pattern = ""
  56. endif
  57.  
  58.  
  59. if type("filt_cond") != "C"
  60.     filt_cond = ""
  61.     use_extproc = .f.
  62. else     
  63.     if filt_cond == ""
  64.         use_extproc = .f.
  65.     else
  66.         use_extproc = .t.
  67.     endif
  68.  
  69. endif
  70.  
  71.  
  72. if type("tries") != "C"
  73.     tries = 3
  74. else
  75.     tries = val(tries)
  76. endif
  77.  
  78.  
  79.  
  80. **  Uncomment this block if you want to display this info
  81. *
  82. *
  83. *?  "dbfname:     "
  84. *??  dbfname
  85. *
  86. *?  "indexname:   "
  87. *??  indexname
  88. *
  89. *?  "lkey:        "
  90. *??  lkey
  91. *
  92. *?  "hkey:        "
  93. *??  hkey
  94. *
  95. *?  "pattern:     "
  96. *??  pattern
  97. *
  98. *?  "use_extproc: " 
  99. *??  use_extproc 
  100. *?
  101. *
  102. *?  "filt_cond: " 
  103. *??  filt_cond 
  104. *?
  105. *
  106. *?  "retry count: " 
  107. *??  tries 
  108. *?
  109. *
  110. *wait
  111. *
  112. *
  113.  
  114.  
  115. dbfname = fixfile( dbfname, "dbf" )
  116.  
  117. if ! file(dbfname)
  118.     ? "Can't find: "+dbfname
  119.     quit
  120. endif
  121.  
  122.  
  123. use (dbfname) 
  124.  
  125.  
  126.  
  127.  
  128. indexname = fixfile(indexname, "ntx" )
  129. if ! file(indexname)
  130.     ? "Cant find: "+indexname
  131.     quit
  132. endif
  133.  
  134.  
  135. if file("_sub.ntx")
  136.     wait [File "_sub.ntx" already exists, do you want to overwrite? ] to yn
  137.     if upper(yn) <> "Y"
  138.         quit
  139.     endif
  140. endif
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147. time1 = seconds()    
  148.  
  149. ********* HERE IT IS *************
  150. **********************************
  151.  
  152. recs = subntx( indexname, "_sub.ntx", lkey, hkey, pattern, use_extproc, tries )
  153.  
  154. **********************************
  155. **********************************
  156.  
  157. time2 = seconds()
  158. times[1] = "Total SubNtx() time: "+str( time2-time1 )          
  159.  
  160. IF recs < 0
  161.     ? "Error returned: "+str(recs)
  162.     quit
  163. endif
  164.  
  165.  
  166.  
  167.  
  168. set index to _sub
  169.  
  170. public flds[ fcount() ]
  171. afields( flds )
  172.  
  173.  
  174.  
  175. DO CLSCREEN
  176. @ 0,0 say "          Browsing " + alltrim(str(recs))+ " records.....Press <Esc> to finish...."
  177. browse()                                          
  178.  
  179.  
  180. clear
  181. ? times[1]
  182.  
  183. use
  184.  
  185. erase _sub.ntx
  186.  
  187.  
  188. *                           End of main
  189. ***************************************************************************
  190.  
  191.  
  192. FUNCTION browse
  193.  
  194.     t = 5
  195.     l = 5
  196.     b = 20
  197.     r = 75
  198.  
  199.  
  200.     @ t-1,l-1 clear to b+1,r+1
  201.     @ t-1,l-1 to b+1,r+1 double
  202.  
  203.     dbedit(t,l,b,r,flds)                                          
  204.     DO CLSCREEN
  205. return ""
  206.  
  207.  
  208.  
  209.  
  210. FUNCTION fixfile
  211.     parameters filename, ext
  212.  
  213.     if [.] $ filename
  214.         filename = substr(filename,1, at(".",filename) ) + ext
  215.     else
  216.         filename = trim(filename)+"."+ ext
  217.     endif
  218.  
  219. return filename 
  220.  
  221.  
  222.  
  223.  
  224. PROCEDURE _subeval
  225.     rec = subrec()
  226.     key = subkey()
  227.     go rec
  228.     if &FILT_COND   && global variable with a valid condition to check
  229.         reteval(.T.)
  230.     else
  231.         reteval(.F.)
  232.     endif
  233. RETURN 
  234.  
  235.  
  236.  
  237.  
  238. PROCEDURE CLSCREEN
  239. setcolor("W/B,+N/W")
  240.  
  241. @ 00,00,24,79 box replicate(chr(177),9)
  242.  
  243. return
  244.